Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue72/dynimag/DrBob.dpr

Text File | 2001-07-03 | 5.5 KB | 201 lines

program DrBob;
{$APPTYPE CONSOLE}
uses
  DrBobCGI, Classes, SysUtils, DB, DBClient
  {$IFDEF ISSUE71}
    , SqlExpr
  {$ENDIF};

  procedure DataSet2HTML(const DataSet: TDataSet);
  var
    fields: Integer;
    RecNo: Integer;
  begin
    writeln('<table border=1>');
    DataSet.Open;
    write('<tr>');
    for fields:=0 to Pred(DataSet.FieldCount) do
      write('<td bgcolor=ffffff><b>',DataSet.Fields[fields].FieldName,'</td>');
    writeln('</tr>');
    DataSet.First;
    RecNo := 0;
    while not DataSet.Eof do
    begin
      Inc(RecNo);
      write('<tr>');
      for fields:=0 to Pred(DataSet.FieldCount) do
        if DataSet.Fields[fields] IS TGraphicField then { GRAPHICS }
          writeln('<td><img src="',ScriptName,'?IMG=yes&RecNo=',RecNo,
            '&FieldName=',DataSet.Fields[fields].FieldName,'"></td>')
        else
          write('<td>',DataSet.Fields[fields].AsString,'</td>');
      writeln('</tr>');
      DataSet.Next
    end;
    writeln('</table>')
  end {DataSet2HTML};

  procedure Record2HTML(const DataSet: TDataSet; RecNo: Integer);
  var
    fields: Integer;
  begin
    if not DataSet.Active then DataSet.Open;
    for fields:=0 to Pred(DataSet.FieldCount) do
      if DataSet.Fields[fields] IS TGraphicField then { GRAPHICS }
        writeln('<b>',DataSet.Fields[fields].FieldName,':</b> ',
          '<img src="',ScriptName,'?IMG=yes&RecNo=',RecNo,'&FieldName=',
            DataSet.Fields[fields].FieldName,'"><br>')
      else
        writeln('<b>',DataSet.Fields[fields].FieldName,':</b> ',
          DataSet.Fields[fields].AsString,'<br>')
  end {Record2HTML};

  procedure NavigatorHTML(const DataSet: TDataSet; RecNo: Integer);
  begin
    if RecNo = 0 then RecNo := 1;
    if not DataSet.Active then DataSet.Open;
    write('<a href="',ScriptName,'?RecNo=1">First</a> | ');
    write('<a href="',ScriptName,'?RecNo=',Pred(RecNo),'">Prior</a> | ');
    write('<a href="',ScriptName,'?RecNo=',Succ(RecNo),'">Next</a> | ');
    write('<a href="',ScriptName,'?RecNo=-1">Last</a> | ');
    write('<a href="',ScriptName,'?RecNo=',RecNo,'">Refresh</a> ',
          '(',RecNo,')<br>')
  end {NavigatorHTML};

  procedure DataSetRecNo(DataSet: TDataSet; var RecNo: Integer);
  var
    i: Integer;
  begin
    DataSet.Open;
    if RecNo = -1 then
    begin
      RecNo := 1;
      while not DataSet.Eof do
      begin
        Inc(RecNo);
        DataSet.Next
      end
    end
    else
      for i:=1 to Pred(RecNo) do DataSet.Next;
    if DataSet.Eof then // went past Eof, need to backtrack!
    begin
      Dec(RecNo); // one before Eof
      DataSet.First;
      for i:=1 to Pred(RecNo) do DataSet.Next
    end
  end {DataSetRecNo};

{$IFDEF ISSUE71}
  procedure DBQuery2HTML(const DB, Query: String; RecNo: Integer);
  var
    SQLConnection1: TSQLConnection;
    DataSet: TSQLDataSet;
  begin
    SQLConnection1 := TSQLConnection.Create(nil);
    with SQLConnection1 do
    begin
      LoadParamsOnConnect := True;
      ConnectionName := DB;
      LoginPrompt := False;
      Connected := True;
    end;
    DataSet := TSQLDataSet.Create(nil);
    try
      DataSet.SQLConnection := SQLConnection1;
      DataSet.CommandText := Query;
      DataSetRecNo(DataSet, RecNo);
      NavigatorHTML(DataSet,RecNo);
      writeln('<hr>');
      Record2HTML(DataSet,RecNo);
      writeln('<hr>');
      NavigatorHTML(DataSet,RecNo);
      writeln('<hr>');
      DataSet2HTML(DataSet);
    finally
      DataSet.Close;
      DataSet.Free;
      SQLConnection1.Free
    end
  end {DBQuery2HTML};
{$ENDIF}

  procedure Table2HTML(const TableName: String; RecNo: Integer);
  var
    DataSet: TClientDataSet;
  begin
    DataSet := TClientDataSet.Create(nil);
    try
      DataSet.FileName := TableName;
      DataSet.Open;
      DataSetRecNo(DataSet, RecNo);
      NavigatorHTML(DataSet,RecNo);
      writeln('<hr>');
      Record2HTML(DataSet,RecNo);
      writeln('<hr>');
      NavigatorHTML(DataSet,RecNo);
      writeln('<hr>');
      DataSet2HTML(DataSet);
    finally
      DataSet.Close;
      DataSet.Free;
    end
  end {Table2HTML};

  procedure Table2Img(const TableName, FieldName: String; RecNo: Integer);
  var
    DataSet: TClientDataSet;
    Str: String;
    i: Integer;
  begin
    DataSet := TClientDataSet.Create(nil);
    try
      DataSet.FileName := TableName;
      DataSetRecNo(DataSet, RecNo);
      Str := (DataSet.FieldByName(FieldName) AS TGraphicField).AsString;
      for i:=9 to Length(Str) do write(Str[i]);
    finally
      DataSet.Close;
      DataSet.Free;
    end
  end {Table2Img};

const
  Biolife = 'biolife.cds';
var
  RecNo: Integer;
  Dir: String;
begin
  RecNo := StrToIntDef(Value('RecNo'),1);
  if Value('IMG') = 'yes' then
  begin
    writeln('content-type: image/bmp');
    writeln;
    Table2Img(Biolife,Value('FieldName'), RecNo)
  end
  else
  try
    writeln('content-type: text/html');
    writeln;
    writeln('<html>');
    writeln('<body bgcolor=ffffcc>');
    writeln(ScriptName,' = ',ParamStr(0),'<br>');
    GetDir(0,Dir);
    writeln('Working Directory: ',Dir,'<br>');
    writeln(RemoteAddress,'<hr>');
    try
    {$IFDEF ISSUE71}
      DBQuery2HTML('IBLocal','select * from customer', RecNo);
    {$ELSE}
      Table2HTML(Biolife, RecNo);
    {$ENDIF}
    except
      on E: Exception do
        writeln(E.ClassName,': ',E.Message)
    end
  finally
    writeln('</body>');
    writeln('</html>')
  end
end.